Final fantasy

Финальный проект

Импорт данных

Open Data Soft предлагает данные по AirBNB. В датасете 85 переменных. Попробуем использовать этот датасет, чтобы увидеть, что влияет на цену аренду арендованных квартир.

Для исследования возьмем Берлин. Из базы выберем 2000 строк.

rm(list = ls())
library(jsonlite)
library(data.table)
library(ggplot2)
library(plotly)

#на портале Open Data Soft есть генератор ссылок для API.  
ODS_API_Link <- "https://data.opendatasoft.com/api/records/1.0/search/?dataset=airbnb-listings%40public&rows=2000&facet=host_response_time&facet=host_response_rate&facet=host_verifications&facet=city&facet=country&facet=property_type&facet=room_type&facet=bed_type&facet=amenities&facet=availability_365&facet=cancellation_policy&facet=features&refine.city=Berlin"

raw_data <- fromJSON(ODS_API_Link)
# Датасет оказался списком. Данные обнаружим по индексу [["records"]][["fields"]]
Full_Data_Table <- as.data.table(raw_data[["records"]][["fields"]])

Взгляд на данные

#Посмотрим, какие бывают переменные
Variables <-names(Full_Data_Table)

#Получим описательные статистики цен по районам Берлина
Price_Descr_stats <- Full_Data_Table[!(is.na(neighbourhood)&!is.na(price)), 
                                     .(.N,
                                      max_price = max(price),
                                     min_price = min(price),
                                     avg_price = mean(price),
                                     sd_price = sd(price)),
                                      by = neighbourhood]


#Иногда из-за единственного наблюдения в группе, появляем NA. Присвоим им 0.
Price_Descr_stats[is.na(sd_price), sd_price := 0]

#Хотим увидеть, какие 10 районов чаще всего встречаются на AirBNB.
Top_10_Rent<-Price_Descr_stats[order(N, decreasing = T)][1:10]


# Посмотрим распределение  частот сдаваемых квартир в каждом районе.
ggplot(Top_10_Rent, aes(x= neighbourhood, y = N, fill = neighbourhood )) + 
  geom_bar(stat = "identity")+
  theme_classic()+
      labs(title= "Распределение сдаваемых квартир по районам",
                      y="Число сдаваемых квартир", x = "Район")

# Посмотрим, есть ли разница по ценам квартир в зависимости от района.
ggplot(Top_10_Rent, aes(x= neighbourhood,  fill = neighbourhood ) ) + 
  geom_boxplot(aes(
      lower = avg_price - sd_price, 
      upper = avg_price + sd_price, 
      middle = avg_price, 
      ymin = avg_price - 3*sd_price, 
      ymax = avg_price + 3*sd_price),
    stat = "identity") + 
  theme_bw()+
    labs(title= "Зависимость цены квартиры от района",
                      y="Цена", x = "Район")

#Очевидно, мы увидим связь между площадью и стоимостью аренды. Однако мало кто указывает площадь. Данных очень мало для моделей, но мы покажем эту связь с  помощью графика.

ggplot(Full_Data_Table, aes(x = square_feet, y = price)) + 
  geom_point(color = "blue")+
  geom_smooth(color = "red") + 
  theme_classic()+
  labs(title= "Зависимость цены квартиры от площади",
                      y="Цена", x = "Площадь квартиры")

# Посмотрим также, как менялось число арендодателей на airbnb с годами в Берлине.
# Отформатируем переменную host_since - когда человек зарегистрировался как арендодатель - оставим только год.
Full_Data_Table[, host_since_year:= format(as.Date(host_since), "%Y") ]
#сгруппируем переменную по годам
Grouped_by_year <- Full_Data_Table[order(host_since_year), .N , by = host_since_year]
# Для того, чтобы показывать рост (а не прирост), сделаем переменную кумулятивной.
Grouped_by_year[,Cumulative_hosts := cumsum(N) ]

#Построим график
plot_ly(data = Grouped_by_year, x = ~host_since_year, y = ~Cumulative_hosts, type = "bar") %>%
  layout(yaxis =  list('Количество арендодателей'), xaxis = list("Год"), title = list("Динамика арендодателей на AirBNB, Berlin") )

Итого

МЫ увидели распределение по частотам арендуемых квартир Берлина. Узнаем, что 5 районов забирают наибольшую долю арендуемых квартир.

В то же время, BoxPlot показал, что разницы в цене нет для различных районов из топ-10. Видим зависимость цены от площади квартиры. О характере связи говорить сложно. Линия графика была подобрана как нелинейная. В то же время линейная модель тоже могла бы быть уместна.

Работа с переменными

Есть несколько переменных, которые могут влиять на цены квартир. Однако для их получения нужны некоторые манипуляции

# Возможно, цена квартиры зависит от расстояния до центра. 
# Чтобы измерить его - возьмем координаты условного центра Берлина - Берлинский собор.
# Измерим евклидово расстояние от координат квартир до Берлинского собора.

# Координаты Берлинского собора:
# Longitude of Berliner Dom: 13.401078
# Latitude of Berliner Dom: 52.519061

BD_Long <- 13.401078
BD_Lat <- 52.519061

# Считаем разницу по ширине и долготе между квартирами и Собором.
Full_Data_Table[,Long_from_center:= BD_Lat - as.numeric(latitude) ]
Full_Data_Table[,Lat_from_center:= BD_Long -  as.numeric(longitude)]

#считаем расстояние по Пифагору
Full_Data_Table[, Distance_from_center  :=  sqrt(Long_from_center^2 + Lat_from_center^2) ]

#Посмотрим, видна ли зависимость между ценой и расстоянием от центра
ggplot(Full_Data_Table, aes(x = Distance_from_center, y =price  ))+ 
  geom_point(color = "red"  ) +theme_bw()

# Арендаторы квартир перечисляют доступные удобства. Также в датасете доступны данные по качеству профиля - верификаций, фото и проч (features).

# Эти переменные перечисляются через запятую. Разделим их и пересчитаем. Новые переменные получат суффикс _count.
cols_to_count <-c("amenities", "features")
Full_Data_Table[ ,  paste0(cols_to_count,"_count") :=
                             lapply(.SD, function(x) sapply(strsplit(x,","), length)),  
                                    .SDcols = cols_to_count] 

Итого

Создали несколько новых переменных - 1) операционализировали рассчитали расстояние от центра (расстояние от квартиры до Берлинского Собора), 2) посчитали количество удобств в квартире в качестве отдельной переменной,
3) Для оценки качества странички арендодателя посчитали атрибуты, которые присутствуют на его страницы

Кластерный анализ

Какие переменные могут предсказывать стоимость сдаваемой квартиры, с моей точки зрения? а) Количество удобств (amenities_count) - чем больше удобств, тем дороже должна стоить квартира.

б) Количество кроватей (beds) - ожидаем положительную связь. Чем больше кроватей, чем больше должна стоить квартира.

в) Стоимость уборки (cleaning_fee) - влияние переменной неоднозначно. С одной стороны,дополнительные расходы за уборку должны побуждать арендодателя сбрасывать цены, чтобы оставаться конкурентным (негативная связь). С другой стороны, ценность квартиры и чистоты в ней может одновременно заставлять повышать стоимость как за аренду, так и за уборку (позитивная связь).

г) Залог за сохранность (security deposit) - влияние неоднозначно (по той же причине, что в пунтке в.)

д) Количество гостей (guests_included) - чем больше гостей, тем больше должна стоить квартира.

5. Дополнительные гости (extra_people) - возможность расширить число гостей должно увеличивать стоимость.

ж) Расстояние от центра (Distance_from_center) - ожидаем отрицательную связь. Чем дальше от центра квартира, тем дешевле должна стоить.

# Выберем список переменных, которые будем изучать.
vars_to_check <- c("price", "amenities_count", "beds",  "cleaning_fee", "security_deposit", "guests_included", "extra_people", "Distance_from_center")

# Заменим NA в переменных, которые их содержат, на среднее 
Full_Data_Table[ ,
                 c("security_deposit", "cleaning_fee") := 
                   lapply(.SD, function(x) replace(x, is.na(x), mean(x, na.rm = T))) ,
                 .SDcols = c("security_deposit", "cleaning_fee")]

# Проведем иерархический кластерный анализ
cluster_fit<-hclust(dist(Full_Data_Table[, vars_to_check, with =F], method = "euclidean") ,
       method = "ward.D" )

plot(cluster_fit)

summary(cluster_fit)

##             Length Class  Mode     
## merge       3998   -none- numeric  
## height      1999   -none- numeric  
## order       2000   -none- numeric  
## labels         0   -none- NULL     
## method         1   -none- character
## call           3   -none- call     
## dist.method    1   -none- character

# Судя по графику, наиболее содержательно выделять три фактора
clusters<-cutree(cluster_fit, k =3)

# Добавим к массиву данных полученные номера кластеров.
Full_Data_Table <- cbind(Full_Data_Table,clusters)

# Посчитаем средние значеения в кластерах
Cluster_Means <- Full_Data_Table[, lapply(.SD, function(x) mean(x, na.rm =T)   ) ,by = clusters,.SDcols = vars_to_check]
Cluster_Means

##    clusters    price amenities_count     beds cleaning_fee
## 1:        1 56.80141        11.80269 1.635897     27.11323
## 2:        2 74.72523        13.12613 1.801802     36.40569
## 3:        3 46.79263        11.83871 1.387097     23.90792
##    security_deposit guests_included extra_people Distance_from_center
## 1:        225.28701        1.327995     7.693145           0.05239577
## 2:        421.41892        1.563063     9.157658           0.04936649
## 3:         95.28571        1.304147     9.336406           0.05393369

# Также посмотрим на наполняемость кластеров
Cluster_Numbers <- Full_Data_Table[, .N ,by = clusters]
Cluster_Numbers

##    clusters    N
## 1:        1 1561
## 2:        2  222
## 3:        3  217

Итого

Для проведения кластерного анализа выбрали переменные, которые могли бы влиять на стоимость аренды квартиры.

Среди них - количество удобств в квартире, расстояние от центра, количество кроватей, цена уборки, залог за сохранность, количество включенных гостей и число дополнительных гостей.

Проведен кластерный анализ. В рамках кластерного анализа выделили три фактора.
Наиболее часто встречающийся фактор - средние квартиры, требущие среднего (относительно других) залога за сохранность и оплаты уборки.

Менее распространены крайние кластеры - 1) Дорогие квартиры с дорогой уборкой с большим залогом 2) Дешевые квартиры с дешевой уборкой и малым залогом.

Таким образом, видим основное различие в ценовых параметрах квартир

Деревья решений

Простое дерево

library(randomForest)
library(rpart)
library(rpart.plot)
library(MLmetrics)

# Переведем цену в бинарный фактор. Две группы - выше и ниже среднего.
Full_Data_Table[, price_binary := ifelse(price<mean(price, na.rm= T), 0,1 )]
Full_Data_Table[, price_binary:= as.factor(price_binary)]

# Создадим выборку-учителя и выборку для теста.
test_rows <- sample(2000, Full_Data_Table[, .N]*0.3 )
Train <-  Full_Data_Table[!test_rows]
Test <- Full_Data_Table[test_rows]

# Вспомним наши исследуемые переменные.
vars_to_check <- c("price_binary", "amenities_count", "beds", "cleaning_fee", "security_deposit", "guests_included", "extra_people", "Distance_from_center" )

# Создадим дерево решений и нарисуем его.
tree_fit <- rpart(price_binary ~ ., Train[, vars_to_check, with = F])
rpart.plot(tree_fit, type =4 )

Случайные леса

# Переменная beds - содержит NA - заменим эти значения на средние
Train[, beds := ifelse(is.na(beds), mean(beds, na.rm = T), beds)]

# Таким образом я хотел бы динамически менять все переменные с NA на среднее переменных.
# Но Accuracy почему-то выходит в 0.
#Train <- Train[, lapply(.SD, function(x) ifelse(is.na(x), mean(x, na.rm = T), x )), .SDcols = vars_to_check]


# Создадим модель случайных лесов.
Forest_Fit <- randomForest(price_binary ~ ., Train[, vars_to_check, with = F])
summary(Forest_Fit)

##                 Length Class  Mode     
## call               3   -none- call     
## type               1   -none- character
## predicted       1400   factor numeric  
## err.rate        1500   -none- numeric  
## confusion          6   -none- numeric  
## votes           2800   matrix numeric  
## oob.times       1400   -none- numeric  
## classes            2   -none- character
## importance         7   -none- numeric  
## importanceSD       0   -none- NULL     
## localImportance    0   -none- NULL     
## proximity          0   -none- NULL     
## ntree              1   -none- numeric  
## mtry               1   -none- numeric  
## forest            14   -none- list     
## y               1400   factor numeric  
## test               0   -none- NULL     
## inbag              0   -none- NULL     
## terms              3   terms  call

# Точность модели - около 60%. О качестве модели говорить сложно. Хотя мы достигли "среднего" уровня точности, такой результат по сути вряд ли может быть полезным. Вместо нашей модели можно использовать подбрасывания монетки. 
Accuracy(Forest_Fit$predicted, Test[, price_binary])

## [1] 0.5828571

Итого

Переменную цены преобразовали в бинарную - значения выше среднего обозначают единицу, ниже среднего - ноль.

Исходя из дерева видим, что наибольшая вероятность арендуемой квартиры примкнуть к более дорогой половине - при большем количестве кроватей и при большей плате за уборку. Тем не менее, модель показывает точность около 0,6. Это говорит о том, что модель способна правильно предсказывать половину случаев принадлежности сдаваемой квартиры. Однако поэтому модель оказывается по сути бесполезной.

Логистическая регрессия

#  Построим модель логистической регресси.
Log_Fit <- glm(price_binary ~.,family=binomial(link='logit'),data=Train[, vars_to_check, with = F])
# Сделаем прогноз на тестовой выборке
fitted.results <- predict(Log_Fit,Test,type='response')
summary(Log_Fit)

## 
## Call:
## glm(formula = price_binary ~ ., family = binomial(link = "logit"), 
##     data = Train[, vars_to_check, with = F])
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -3.4361  -0.7736  -0.5367   0.7813   2.4578  
## 
## Coefficients:
##                        Estimate Std. Error z value Pr(>|z|)    
## (Intercept)          -4.9093103  0.3573518 -13.738  < 2e-16 ***
## amenities_count       0.0518797  0.0151832   3.417 0.000633 ***
## beds                  0.4430550  0.0750076   5.907 3.49e-09 ***
## cleaning_fee          0.0678087  0.0070356   9.638  < 2e-16 ***
## security_deposit      0.0019135  0.0007949   2.407 0.016079 *  
## guests_included       0.8003638  0.1333617   6.001 1.96e-09 ***
## extra_people         -0.0013623  0.0075924  -0.179 0.857599    
## Distance_from_center -7.6502065  2.2002339  -3.477 0.000507 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 1835.2  on 1399  degrees of freedom
## Residual deviance: 1406.7  on 1392  degrees of freedom
## AIC: 1422.7
## 
## Number of Fisher Scoring iterations: 5

# Проверим качество модели. Когда вероятность больше 0.5 - будем считать наблюдение 1 (цена выше среднего). Когда меньше 0.5 - считаем, что цена ниже среднего.
fitted.results[fitted.results > 0.5] <- 1
fitted.results[fitted.results < 0.5] <- 0

# С помощью корреляции посмотрим, насколько хорошо модели предсказывает значения. 
cor.test(as.numeric(Test$price_binary), as.numeric(fitted.results ))

## 
##  Pearson's product-moment correlation
## 
## data:  as.numeric(Test$price_binary) and as.numeric(fitted.results)
## t = 13.9, df = 597, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.4314581 0.5526950
## sample estimates:
##       cor 
## 0.4944779

Итого

Логистическая регрессия показала значимость всех факторов, кроме переменных “дополнительных гостей” и “залога за сохранность”. Остальные переменные показали 99% значимость.

Проверили качество модели на тестовой выборке. Для этого проверили корреляции предсказаний переменной и реальные значения на тестовой выборке. Обнаружили корреляцию в районе 0.5. Предсказания совпадают с реальностью в половине случаев. Справедливо как и в модели деревьев решений поднять вопрос о полезности этой модели.

Линейная регрессия

# Проведем линейную регрессию.
# Уберем из списка переменных бинарную переменную цены, добавив переменную цены без выбросов.

#Убираем бинарную переменную.
vars_to_check <- vars_to_check[-which(vars_to_check =="price_binary")]

# В показателе цены много выбросов. Они могут помешать регрессионной модели. Избавимся от них

# Выбросы могут быть только в сторону повышения. (поэтому левый край не смотрим) (mean(price) - 2*sd...)
Train[price < (mean(price) + 2*sd(price, na.rm =T)), Price_no_outliers:= price]
Train[price > (mean(price) + 2*sd(price, na.rm =T)), Price_outliers:= price]

vars_to_check <- c("Price_no_outliers", vars_to_check )

#Строим линейную модель
Lin_Fit <- lm(Price_no_outliers~., data=Train[, vars_to_check, with = F])
confint(Lin_Fit)

##                              2.5 %      97.5 %
## (Intercept)             2.50901547  13.6406487
## amenities_count         0.41211232   0.9754854
## beds                    2.73262203   5.4418938
## cleaning_fee            0.53395333   0.7455681
## security_deposit        0.01122447   0.0399725
## guests_included         6.35116534  10.2002658
## extra_people           -0.09297817   0.1928533
## Distance_from_center -134.78045877 -59.4877120

summary(Lin_Fit)

## 
## Call:
## lm(formula = Price_no_outliers ~ ., data = Train[, vars_to_check, 
##     with = F])
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -72.354 -15.360  -3.349  12.414 108.166 
## 
## Coefficients:
##                        Estimate Std. Error t value Pr(>|t|)    
## (Intercept)            8.074832   2.837180   2.846 0.004494 ** 
## amenities_count        0.693799   0.143590   4.832 1.51e-06 ***
## beds                   4.087258   0.690527   5.919 4.11e-09 ***
## cleaning_fee           0.639761   0.053935  11.862  < 2e-16 ***
## security_deposit       0.025598   0.007327   3.494 0.000492 ***
## guests_included        8.275716   0.981041   8.436  < 2e-16 ***
## extra_people           0.049938   0.072851   0.685 0.493166    
## Distance_from_center -97.134085  19.190272  -5.062 4.74e-07 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 22.7 on 1335 degrees of freedom
##   (57 observations deleted due to missingness)
## Multiple R-squared:  0.2923, Adjusted R-squared:  0.2886 
## F-statistic: 78.77 on 7 and 1335 DF,  p-value: < 2.2e-16

Итого

Согласно линейной модели, все коэффициенты значимы. Большинство из них даже на 99% уровне значимости. Однако влияние этих переменных достаточно мало.

Наиболее сильное влияние оказывает переменная расстояния от центра. Однако измерить его конкретное влияние затруднительно, поскольку величина обозначает географические координаты (а не метры).

По значимости эта переменная сильно опережает другие. Другие переменные вносят менее значительный вклад (19.78530 - std. Error). Среди них наиболее значимая переменная - количество гостей (0.85431).

Расстояние от центра негативно связано с ценой - чем больше расстояние от центра, тем ниже цена. Остальные переменные связаны с ценой положительно.

В то же время, модель объясняет достаточно мало наблюдений R^2 - около 30%.

Выводы

В Берлине стоимость аренды квартиры не зависит от района, в котором она находится.

Однако есть проявляющаяся не во всех случаях зависимость цены квартиры от расстояния до центра.

Также на основе моделей можно говорить о значимости влияния таких переменных как количество удобств, количество кроватей, количество гостей и стоимость уборки. Остается под сомнением вклад таких переменных, как залог или дополнительные гости.